home *** CD-ROM | disk | FTP | other *** search
/ Aminet 16 / Aminet 16 (1996)(GTI - Schatztruhe)[!][Dec 1996].iso / Aminet / dev / src / wangisrc.lha / wangi / z / SM / SMPrefs / Window_Qualifier.PAS < prev    next >
Pascal/Delphi Source File  |  1995-07-11  |  6KB  |  221 lines
  1. Procedure QualWin;
  2.  
  3. CONST
  4.     NI       = 0; 
  5.     CC       = 1; 
  6.     G_LSHIFT = 2; 
  7.     G_RSHIFT = 3; 
  8.     G_CAPS   = 4;
  9.     G_CTRL   = 5;
  10.     G_LALT   = 6;
  11.     G_RALT   = 7;
  12.     G_LAMIGA = 8;
  13.     G_RAMIGA = 9;
  14.     G_LMB    = 10;
  15.     G_MMB    = 11;
  16.     G_RMB    = 12;
  17.     G_APP    = 13;
  18.     G_OK     = 14;  
  19.     G_CAN    = 15;
  20.     RKey : pRemember = NIL;
  21.      
  22. VAR 
  23.     T                            : Array[0..15] of tTagItem;
  24.     GadFlags            : tNewGadget;
  25.     G                            : Array[NI..G_CAN] of pGadget;
  26.     dummy                    : LONG;
  27.     ExitFlag, OK    : Boolean;
  28.     TheWin                : pWindow;
  29.     message                : pIntuiMessage;
  30.     MsgClass, msgcode            : LongInt;
  31.     gadcode       : pGadget;
  32.     Labs          : Array[G_LSHIFT..G_CAN] of STRPTR;
  33.     quals         : Array[G_LSHIFT..G_CAN] of LONG; 
  34.     cl            : Array[0..2] of STRPTR;
  35.     n, tmpapp     : Integer;
  36.  
  37. begin
  38.     tmpapp := CD.cd_App;
  39.     { Init labs }
  40.     Labs[G_LSHIFT] := CStrConstPtrAR(@RKey, 'Left Shift'); 
  41.     Labs[G_RSHIFT] := CStrConstPtrAR(@RKey, 'Right Shift'); 
  42.     Labs[G_CAPS]   := CStrConstPtrAR(@RKey, 'Caps Lock');
  43.     Labs[G_CTRL]   := CStrConstPtrAR(@RKey, 'Control');
  44.     Labs[G_LALT]   := CStrConstPtrAR(@RKey, 'Left Alt');
  45.     Labs[G_RALT]   := CStrConstPtrAR(@RKey, 'Right Alt');
  46.     Labs[G_LAMIGA] := CStrConstPtrAR(@RKey, 'Left Amiga');
  47.     Labs[G_RAMIGA] := CStrConstPtrAR(@RKey, 'Right Amiga');
  48.     Labs[G_LMB]    := CStrConstPtrAR(@RKey, 'Left Mouse Button');
  49.     Labs[G_MMB]    := CStrConstPtrAR(@RKey, 'Middle Mouse Button');
  50.     Labs[G_RMB]    := CStrConstPtrAR(@RKey, 'Right Mouse Button');
  51.     Labs[G_OK]     := CStrConstPtrAR(@RKey, 'Ok');  
  52.     Labs[G_CAN]    := CStrConstPtrAR(@RKey, 'Cancel');
  53.     
  54.     { init quals }
  55.     Quals[G_LSHIFT] := IEQUALIFIER_LSHIFT;
  56.     Quals[G_RSHIFT] := IEQUALIFIER_RSHIFT;
  57.     Quals[G_CAPS]   := IEQUALIFIER_CAPSLOCK;
  58.     Quals[G_CTRL]   := IEQUALIFIER_CONTROL;
  59.     Quals[G_LALT]   := IEQUALIFIER_LALT;
  60.     Quals[G_RALT]   := IEQUALIFIER_RALT;
  61.     Quals[G_LAMIGA] := IEQUALIFIER_LCOMMAND;
  62.     Quals[G_RAMIGA] := IEQUALIFIER_RCOMMAND;
  63.     Quals[G_LMB]    := IEQUALIFIER_LEFTBUTTON;
  64.     Quals[G_MMB]    := IEQUALIFIER_MIDBUTTON;
  65.     Quals[G_RMB]    := IEQUALIFIER_RBUTTON;
  66.     
  67.     G[NI] := NIL;
  68.     G[CC] := CreateContext(@g[NI]);
  69.     If G[CC] <> NIL Then begin
  70.     
  71.         T[0].ti_Tag  := GTCB_Checked;
  72.         T[0].ti_Data := ord(CD.cd_NoClick);
  73.         T[1].ti_Tag  := $80080044;  { GTCB_Scaled }
  74.         T[1].ti_Data := True_;
  75.         T[2].ti_Tag  := TAG_DONE;
  76.  
  77.         With GadFlags Do Begin
  78.             ng_Width      := Sizes[S_CM_W];
  79.             ng_Height     := Sizes[S_GAD_H];
  80.             ng_LeftEdge   := Sizes[S_WB_L]+8;
  81.             ng_TopEdge    := (Sizes[TBS]+4);
  82.             ng_TextAttr   := @My_Font;
  83.             ng_VisualInfo := vi;
  84.             ng_Flags      := PLACETEXT_RIGHT;
  85.         End;
  86.         
  87.         { make the CB gadgets }
  88.         n := 0;
  89.         For n := G_LSHIFT to G_RMB do begin
  90.             If n = G_LAMIGA then begin
  91.                 With GadFlags do begin
  92.                     ng_LeftEdge := ng_LeftEdge + ng_Width+((Sizes[QTxt_W]*2) div 3);
  93.                     ng_TopEdge := (Sizes[TBS]+4);
  94.                 End;
  95.             End;
  96.             if CD.cd_Quals and Quals[n] <> 0 then
  97.                 T[0].ti_Data := True_
  98.             else
  99.                 T[0].ti_Data := False_;
  100.             With GadFlags do begin
  101.                 ng_GadgetID   := n;
  102.                 ng_GadgetText := Labs[n];
  103.             end;
  104.             G[n] := CreateGadgetA(CHECKBOX_KIND, G[n-1], @GadFlags, @T);
  105.             With GadFlags do
  106.                 ng_TopEdge := ng_TopEdge+ng_Height+1;
  107.         end;
  108.             
  109.         CL[0] := CStrConstPtrAR(@RKey, 'All'); 
  110.         CL[1] := CStrConstPtrAR(@RKey, 'One');
  111.         CL[2] := NIL;
  112.         
  113.         T[0].ti_Tag  := GTCY_Labels;
  114.         T[0].ti_Data := Long(@CL);
  115.         T[1].ti_Tag  := GTCY_Active;
  116.         T[1].ti_Data := CD.cd_App;
  117.         T[2].ti_Tag  := TAG_DONE;
  118.         With GadFlags Do Begin
  119.             ng_Width      := Sizes[S_G2_W];
  120.             ng_LeftEdge   := Sizes[S_WB_L]+8;
  121.             With G[G_RALT]^ do
  122.                 ng_TopEdge    := TopEdge+Height+2;
  123.             ng_Height     := Sizes[S_GAD_H];
  124.             ng_GadgetText := CStrConstPtrAR(@RKey, 'Applicability');
  125.             ng_GadgetID   := G_APP;
  126.             ng_Flags      := PLACETEXT_RIGHT;
  127.         End;
  128.         G[G_APP] := CreateGadgetA(CYCLE_KIND, G[G_RMB], @Gadflags, @T);
  129.              
  130.         T[0].ti_Tag := TAG_END;
  131.         With GadFlags Do Begin
  132.             ng_Width      := (Sizes[S_G2_W] div 3);
  133.             ng_TopEdge    := ng_TopEdge+ng_Height+8;
  134.             ng_GadgetText := Labs[G_OK];
  135.             ng_GadgetID   := G_OK;
  136.             ng_Flags      := 0;
  137.         End;
  138.         G[G_OK] := CreateGadgetA(BUTTON_KIND, G[G_APP], @GadFlags, @T);
  139.      
  140.         With GadFlags Do Begin
  141.             ng_LeftEdge   := G[G_LAMIGA]^.LeftEdge+G[G_LAMIGA]^.Width+Sizes[QTxt_W]-ng_Width; 
  142.             ng_GadgetText := Labs[G_CAN];
  143.             ng_GadgetID   := G_CAN;
  144.         End;
  145.         G[G_CAN] := CreateGadgetA(BUTTON_KIND, G[G_OK], @GadFlags, @T);
  146.      
  147.         T[0].ti_Tag  := WA_Left;
  148.         T[0].ti_Data := Left;
  149.         T[1].ti_Tag  := WA_Top;
  150.         T[1].ti_Data := Top;
  151.         T[2].ti_Tag  := WA_Width;
  152.         T[2].ti_Data := gadflags.ng_LeftEdge+gadflags.ng_Width+12;
  153.         T[3].ti_Tag  := WA_Height;
  154.         T[3].ti_Data := g[G_CAN]^.TopEdge + g[G_CAN]^.Height + Sizes[S_WB_B] + 4;
  155.         T[4].ti_Tag  := WA_Title;
  156.         T[4].ti_Data := LONG(CStrConstPtrAR(@RKey, 'Select qualifiers')); 
  157.         T[5].ti_Tag  := WA_IDCMP;
  158.         T[5].ti_Data := BUTTONIDCMP|IDCMP_GADGETUP|CHECKBOXIDCMP|
  159.                                 IDCMP_REFRESHWINDOW|IDCMP_CLOSEWINDOW;
  160.         T[6].ti_Tag  := WA_CloseGadget;
  161.         T[6].ti_Data := True_;
  162.         T[7].ti_Tag  := WA_DragBar;
  163.         T[7].ti_Data := True_;
  164.         T[8].ti_Tag  := WA_DepthGadget;
  165.         T[8].ti_Data := True_;
  166.         T[9].ti_Tag  := WA_AutoAdjust;
  167.         T[9].ti_Data := True_;
  168.         T[10].ti_Tag := WA_Activate;
  169.         T[10].ti_Data:= True_;
  170.         T[12].ti_Tag := WA_Gadgets;
  171.         T[12].ti_Data:= LONG(g[NI]);
  172.         T[13].ti_Tag := WA_SimpleRefresh;
  173.         T[13].ti_Data:= True_; 
  174.         T[14].ti_Tag := TAG_DONE;
  175.     
  176.         TheWin := OpenWindowTaglist(NIL,@T);
  177.         If TheWin <> NIL Then begin
  178.             GT_RefreshWindow(TheWin, NIL);
  179.         
  180.             ExitFlag := False;
  181.             While Not exitflag Do Begin
  182.                 dummy := Wait(BitMask(TheWin^.UserPort^.MP_SIGBIT));
  183.                 message  := GT_GetIMsg(TheWin^.userPort);
  184.             While message <> NIL do begin
  185.                 MsgClass := message^.Class;
  186.                 MsgCode  := Message^.Code;
  187.                 if MsgClass = IDCMP_GADGETUP then 
  188.                     GadCode  := pGadget(message^.IAddress);
  189.                 GT_ReplyIMsg(message);
  190.                 Case MsgClass Of
  191.           
  192.                     IDCMP_REFRESHWINDOW : Begin
  193.                         GT_BeginRefresh(TheWin);
  194.                         GT_EndRefresh(TheWin, True);
  195.                     end;
  196.                     IDCMP_CLOSEWINDOW : ExitFlag := True;
  197.                     IDCMP_GADGETUP : Begin
  198.                         Case gadcode^.GadgetID Of
  199.                             G_APP : tmpapp := msgcode;
  200.                             G_OK   : begin
  201.                                 ExitFlag := True;
  202.                                 CD.cd_App := tmpApp;
  203.                                 CD.cd_Quals := 0;
  204.                                 for n := G_LSHIFT to G_RMB do begin
  205.                                     if G[n]^.Flags and GFLG_SELECTED <> 0 then 
  206.                                         CD.cd_Quals := CD.cd_Quals|Quals[n];
  207.                                 end;
  208.                             end;
  209.                             G_CAN : ExitFlag := True;
  210.                         End;
  211.                     end;
  212.                 End;
  213.                 message  := GT_GetIMsg(TheWin^.userPort);
  214.                 end;
  215.             End;
  216.             CloseWindow(TheWin);
  217.             FreeGadgets(g[NI]);
  218.         end;
  219.     end;
  220.     FreeRemember(@RKey, true);
  221. end;